home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Module source / call1&Lmod.txt < prev    next >
Encoding:
Text File  |  1995-09-22  |  1.1 KB  |  54 lines  |  [TEXT/MSET]
  1. \ This module handles the CallFirst and CallLast operations.  Aug 91.
  2.  
  3. : 1ST&LAST    14 -  ;
  4.  
  5. : CallFirst
  6.     ?exec  #last ?error 51
  7.     getSelect  1 ++> #1st  ;        immediate
  8.  
  9. : CallLast
  10.     ?exec
  11.     getSelect  1 ++> #last  ;        immediate
  12.  
  13.  
  14. : (GET)  { mark \ #F #L cnt addr -- mark }
  15.     0 -> #F  0 -> #L
  16.     #1st #last +  -> cnt
  17.     BEGIN  cnt  WHILE  >r  1 --> cnt  REPEAT    \ Reverse into return stk!
  18.     superM
  19.     IF    superM 1-  7 btest
  20.         IF    superM 1st&last -> addr  addr w@ -> #F
  21.             addr 2+ w@ -> #L
  22.         THEN
  23.     THEN
  24.   \ Get 1st
  25.     #F #L + 4*  --> addr
  26.     #F 0 ?DO  addr @  ,  4 ++> addr  LOOP
  27.     #1st -> cnt
  28.     BEGIN  cnt  WHILE  r> ,  1 --> cnt  REPEAT
  29.   \ Get last
  30.     #L 0 ?DO  addr @  ,  4 ++> addr  LOOP
  31.     #last -> cnt
  32.     BEGIN  cnt  WHILE  r> ,  1 --> cnt  REPEAT
  33.     #F ++> #1st  #L ++> #last
  34.     #1st #last or IF  #1st w,  #last w,  THEN
  35.     mark  ;
  36.  
  37. : (C1)  { \ addr -- }
  38.     #1st 0EXIT
  39.     thisM 1st&last  -> addr  #1st #last + 4*  --> addr
  40.     #1st FOR
  41.         true -> selfRef?
  42.         addr @  ^class  findm  swap  bind_to_self
  43.         ?unHoldMod  4 ++> addr
  44.     NEXT  ;
  45.  
  46. : (CL)  { \ addr -- }
  47.     #last  0EXIT
  48.     thisM 1st&last  -> addr
  49.     #last FOR
  50.         true -> selfRef?  4 --> addr
  51.         addr @  ^class  findm  swap  bind_to_self
  52.         ?unHoldMod
  53.     NEXT  ;
  54.